Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/magnif1a/magnifie.frm

Text File | 1999-09-12 | 6KB | 153 lines

VERSION 5.00
Begin VB.Form Form1
   Caption         =   "MagNifier2"
   ClientHeight    =   2445
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   2055
   LinkTopic       =   "Form1"
   ScaleHeight     =   163
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   137
   StartUpPosition =   3  'Windows Default
   Begin VB.Timer Timer1
      Interval        =   50
      Left            =   1080
      Top             =   720
   End
   Begin VB.VScrollBar VScroll1
      Height          =   1575
      LargeChange     =   5
      Left            =   1560
      Max             =   100
      Min             =   1
      TabIndex        =   1
      Top             =   0
      Value           =   100
      Width           =   255
   End
   Begin VB.Label Label2
      Alignment       =   1  'Right Justify
      Caption         =   "1"
      Height          =   255
      Left            =   1560
      TabIndex        =   2
      Top             =   2160
      Width           =   495
   End
   Begin VB.Label Label1
      Caption         =   "Label1"
      Height          =   255
      Left            =   0
      TabIndex        =   0
      Top             =   2160
      Width           =   1215
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'MagNifier2 by oigres P. Email [e-mail]
'Based on the C++ tool Zoomin (Lupe?)
'New features :Resizeable form, new resolution, bug fix 12/sept/99
'All code written by oigres P.
'indented by indenter5 from http://www.BMSLtd.co.uk by Stephen Bullen
'
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long

Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long

Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Const HORZRES = 8
Private Const VERTRES = 10


Private Type POINTAPI
    x As Long
    y As Long
End Type
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
Const RDW_ERASE = &H4
Const RDW_INVALIDATE = &H1
Const SRCCOPY = &HCC0020
Const WM_PAINT = &HF

Dim frmH As Long, magnify As Integer

Private Sub Form_Load()
    Call VScroll1_Change
    'SetCapture Form1.hwnd
End Sub

Private Sub Form_Resize()
    Form1.Cls 'clear rubbish between labels when resize
    VScroll1.Left = Form1.ScaleWidth - VScroll1.Width
    VScroll1.Height = Form1.ScaleHeight - Label1.Height
    Label1.Top = Form1.ScaleHeight - Label1.Height
    Label2.Left = Form1.ScaleWidth - Label2.Width
    Label2.Top = Form1.ScaleHeight - Label2.Height
End Sub

Private Sub Label1_Click()
MsgBox "MagNifier2 by oigres P" & vbCrLf & _
"Email: [e-mail]", vbInformation, "MagNifier2"
End Sub

Private Sub Timer1_Timer()
    Dim cp As POINTAPI
    GetCursorPos cp
    Label1.Caption = cp.x & Space(6 - Len(CStr(cp.x))) & ":" & cp.y

    Dim dsDC As Long, lpPT As POINTAPI


    dsDC = GetDC(0&)
    'get screen width, height
    hr = GetDeviceCaps(dsDC, HORZRES)
    vr = GetDeviceCaps(dsDC, VERTRES)

    dshwnd = GetDesktopWindow()
    '      vscroll1=1..100 so 1/100=.1; 100/100=1;New Resolution
    Percent = VScroll1.Value / 100
    lengthx = (Form1.ScaleWidth - VScroll1.Width) * Percent
    lengthy = (Form1.ScaleHeight - Label1.Height) * Percent
    'center image about mouse
    offsetx = lengthx \ 2
    offsety = lengthy \ 2
    blitareax = Form1.ScaleWidth - VScroll1.Width 'actual area to blit to
    blitareay = Form1.ScaleHeight - Label1.Height
    'Debug.Print lengthx; lengthy; Percent; offsetx; offsety
    'stop copying the screen off the edges <0 and  >horzres
    If cp.x - offsetx >= 0 And cp.x + offsetx < hr Then '800=screen width
        If cp.y - offsety >= 0 And cp.y + offsety < vr Then '600= screen height

            '                dest hdc ,destx,desty,width,height, sourceDC, source x,sourcey,sourcewidth,sourceheight,raster operation
            ret = StretchBlt(Form1.hdc, 0, 0, blitareax, blitareay, dsDC, cp.x - offsetx, cp.y - offsety, lengthx, lengthy, SRCCOPY)
        End If
    End If
    'Form1.Line (0, 0)-(Form1.ScaleWidth - VScroll1.Width, Form1.ScaleHeight - Label1.Height)
    'Form1.Line (Form1.ScaleWidth - VScroll1.Width, 0)-(0, Form1.ScaleHeight - Label1.Height)
    ReleaseDC dshwnd, dsDC 'previous bug not releasing memory
End Sub

Private Sub VScroll1_Change()
    'magnify = VScroll1.Value ;100 is max vscroll value
    'output 2 decimal places
    Label2.Caption = Format(100 / VScroll1.Value, "FIXED")
End Sub

Private Sub VScroll1_Scroll()
    Label2.Caption = Format(100 / VScroll1.Value, "FIXED")
End Sub